AmigActive 25/AACD 25.iso/AACD/Graphics/PerfectPaint/rexx/box/Puzzle.rx

Text File | 2000-09-10 | 6.7 KB | 402 lines

/* Box arexx test */

    options results
  parse ARG Port x1 y1 x2 y2 b
    ADDRESS value Port

    SizeW=x2-x1+1
  SizeH=y2-y1+1

  Nbx=5
  Nby=5
    Shade=50
    Dec=1
    Type=0

    IF EXISTS('PerfectPaint:Prefs/Rexx_Prefs/Puzzle') THEN DO
        IF OPEN('lfile','PerfectPaint:Prefs/Rexx_Prefs/Puzzle', "R") then DO
            Nbx= READLN('lfile')
            Nby= READLN('lfile')
            Shade= READLN('lfile')
            Type= READLN('lfile')
            CALL CLOSE('lfile')
        END
    END

    pp_DialogInit 230 125 "*PUZZLE*" 4
        pp_Integer 0 110 5 50 16 "Nb*of*pieces*H" 1 Nbx
        pp_Integer 1 110 25 50 16 "Nb*of*Pieces*V" 1 Nby
        pp_Integer 2 110 45 50 16 "Power" 1 Shade
        pp_Cycle   3 110 75 80 16 "Type" 1 "Classic|Simple" Type
    pp_Dialog
    rc=result
    IF rc=0 then DO
        EXIT
    END

    pp_PenType 0
    pp_AliasOn

    pp_GetDialog 0
    Nbx=result
    IF Nbx<2 then DO
        Nbx=2
    END

    pp_GetDialog 1
    Nby=result
    IF Nby<2 then DO
        Nby=2
    END

    pp_GetDialog 2
    Shade=result

    pp_GetDialog 3
    Type=result

    CALL SavePrefs('Puzzle',Nbx,Nby,Shade,Type)
    ADDRESS value Port

    pp_UpdateUndoBox x1-2 y1-2 x2+2 y2+2

  Stepx=trunc(SizeW/Nbx+0.5)
  Stepy=trunc(SizeH/Nby+0.5)

    pp_EffectOn
    pp_Shade Shade
    pp_Box x1 y1 x2 y2
    pp_Light Shade
    pp_Box x1+Dec y1+Dec x2+Dec y2+Dec


IF Type=1 then DO
    DO j=y1+Stepy-1 to y1+(Stepy*(Nby-1)) by Stepy
      DO i=x1 to x1+(Stepx*(Nbx-1)) by Stepx
            n.i=TRUNC(RANDU(time('S'))+0.5)
        END
        DO k=1 to 2
            IF k=1 THEN DO
                pp_Shade Shade
            END
            ELSE DO
                pp_Light Shade
            END
            pp_StartPoly
          DO i=x1 to x1+(Stepx*(Nbx-1)) by Stepx
                IF i=x1 then DO
                    CALL MultiPoly(4,i,j)
                END
                IF k=1 then DO
                    CALL LineH1(i,j,Stepx,Stepy,n.i,x2)
                END
                ELSE DO
                    CALL LineH1(i+Dec,j+Dec,Stepx,Stepy,n.i,x2)
                END
            END
            IF i+stepx<x2 THEN DO
                CALL MultiPoly(3,i+stepx,j)
            END
            ELSE DO
                CALL MultiPoly(3,x2,j)
            END
            pp_EndPolyS
        END
    END

    DO i=x1+Stepx-1 to x1+(Stepx*(Nbx-1)) by Stepx
      DO j=y1 to y1+(Stepy*(Nby-1)) by Stepy
            n.j=TRUNC(RANDU(time('S'))+0.5)
        END
        DO k=1 to 2
            IF k=1 THEN DO
                pp_Shade Shade
            END
            ELSE DO
                pp_Light Shade
            END
            pp_StartPoly
          DO j=y1 to y1+(Stepy*(Nby-1)) by Stepy
                IF j=y1 then DO
                    CALL MultiPoly(4,i,j)
                END
                IF k=1 then DO
                    CALL LineV1(i,j,Stepx,Stepy,n.j,y2)
                END
                ELSE DO
                    CALL LineV1(i+Dec,j+Dec,Stepx,Stepy,n.j,y2)
                END
            END
            IF j+Stepy<y2 then DO
                CALL MultiPoly(3,i,j+stepy)
            END
            ELSE DO
                CALL MultiPoly(3,i,y2)
            END
            pp_EndPolyS
        END
    END

END


IF Type=0 then DO
    DO j=y1+Stepy-1 to y1+(Stepy*(Nby-1)) by Stepy
      DO i=x1 to x1+(Stepx*(Nbx-1)) by Stepx
            n.i=TRUNC(RANDU(time('S'))+0.5)
        END
        DO k=1 to 2
            IF k=1 THEN DO
                pp_Shade Shade
            END
            ELSE DO
                pp_Light Shade
            END
            pp_StartPoly
          DO i=x1 to x1+(Stepx*(Nbx-1)) by Stepx
                IF i=x1 then DO
                    CALL MultiPoly(4,i,j)
                END
                IF k=1 then DO
                    CALL LineH(i,j,Stepx,Stepy,n.i,x2)
                END
                ELSE DO
                    CALL LineH(i+Dec,j+Dec,Stepx,Stepy,n.i,x2)
                END
            END
            IF i+stepx<x2 THEN DO
                CALL MultiPoly(3,i+stepx,j)
            END
            ELSE DO
                CALL MultiPoly(3,x2,j)
            END
            pp_EndPolyS
        END
    END

    DO i=x1+Stepx-1 to x1+(Stepx*(Nbx-1)) by Stepx
      DO j=y1 to y1+(Stepy*(Nby-1)) by Stepy
            n.j=TRUNC(RANDU(time('S'))+0.5)
        END
        DO k=1 to 2
            IF k=1 THEN DO
                pp_Shade Shade
            END
            ELSE DO
                pp_Light Shade
            END
            pp_StartPoly
          DO j=y1 to y1+(Stepy*(Nby-1)) by Stepy
                IF j=y1 then DO
                    CALL MultiPoly(4,i,j)
                END
                IF k=1 then DO
                    CALL LineV(i,j,Stepx,Stepy,n.j,y2)
                END
                ELSE DO
                    CALL LineV(i+Dec,j+Dec,Stepx,Stepy,n.j,y2)
                END
            END
            IF j+Stepy<y2 then DO
                CALL MultiPoly(3,i,j+stepy)
            END
            ELSE DO
                CALL MultiPoly(3,i,y2)
            END
            pp_EndPolyS
        END
    END
END

pp_EffectOff
EXIT


LineH: PROCEDURE
    X=ARG(1)
    Y=ARG(2)
    X2=ARG(3)
    S=ARG(3)/3
    SS=ARG(4)/4
    n=ARG(5)
    W=ARG(6)

    IF n=0 THEN DO
            pp_AddPoly X+S Y+ARG(3)/12
            pp_AddPoly X+S+ARG(3)/12 Y-ARG(3)/12
      pp_AddPoly X+S Y-SS
      pp_AddPoly X+S+S/2 Y-SS-ARG(3)/12
            pp_AddPoly X+S*2 Y-SS
            pp_AddPoly X+S*2-ARG(3)/12 Y-ARG(3)/12
            pp_AddPoly X+S*2 Y+ARG(3)/12
        IF X+X2<W THEN DO
            pp_AddPoly X+X2 Y
        END
        ELSE DO
            pp_AddPoly W Y
        END
    END
    ELSE DO
            pp_AddPoly X+S Y-ARG(3)/12
            pp_AddPoly X+S+ARG(3)/12 Y+ARG(3)/12
      pp_AddPoly X+S Y+SS
      pp_AddPoly X+S+S/2 Y+SS+ARG(3)/12
            pp_AddPoly X+S*2 Y+SS
            pp_AddPoly X+S*2-ARG(3)/12 Y+ARG(3)/12
            pp_AddPoly X+S*2 Y-ARG(3)/12
        IF X+X2<W THEN DO
            pp_AddPoly X+X2 Y
        END
        ELSE DO
            pp_AddPoly W Y
        END
    END

RETURN

LineV: PROCEDURE
    X=ARG(1)
    Y=ARG(2)
    Y2=ARG(4)
    S=ARG(4)/3
    SS=ARG(3)/4
    n=ARG(5)
    H=ARG(6)
    IF n=0 THEN DO
            pp_AddPoly X-ARG(4)/12 Y+S
            pp_AddPoly X+ARG(4)/12 Y+S+ARG(4)/12
      pp_AddPoly X+SS Y+S
            pp_AddPoly X+SS+ARG(4)/12 Y+S+S/2
            pp_AddPoly X+SS Y+S*2
            pp_AddPoly X+ARG(4)/12 Y+S*2-ARG(4)/12
            pp_AddPoly X-ARG(4)/12 Y+S*2
        IF Y+Y2<H THEN DO
            pp_AddPoly X Y+Y2
        END
        ELSE DO
            pp_AddPoly X H
        END
    END
    ELSE DO
            pp_AddPoly X+ARG(4)/12 Y+S
            pp_AddPoly X-ARG(4)/12 Y+S+ARG(4)/12
      pp_AddPoly X-SS Y+S
            pp_AddPoly X-SS-ARG(4)/12 Y+S+S/2
      pp_AddPoly X-SS Y+S*2
            pp_AddPoly X-ARG(4)/12 Y+S*2-ARG(4)/12
            pp_AddPoly X+ARG(4)/12 Y+S*2
        IF Y+Y2<H THEN DO
            pp_AddPoly X Y+Y2
        END
        ELSE DO
            pp_AddPoly X H
        END
    END

RETURN

LineH1: PROCEDURE
    X=ARG(1)
    Y=ARG(2)
    X2=ARG(3)
    S=ARG(3)/3
    SS=ARG(4)/4
    n=ARG(5)
    W=ARG(6)

    IF n=0 THEN DO
            pp_AddPoly X+S Y
            pp_AddPoly X+S Y
      pp_AddPoly X+S Y-SS
      pp_AddPoly X+S*2 Y-SS
      pp_AddPoly X+S*2 Y
      pp_AddPoly X+S*2 Y
      pp_AddPoly X+S*3 Y
        IF X+X2<W THEN DO
            pp_AddPoly X+X2 Y
        END
        ELSE DO
            pp_AddPoly W Y
        END
    END
    ELSE DO
            pp_AddPoly X+S Y
            pp_AddPoly X+S Y
      pp_AddPoly X+S Y+SS
      pp_AddPoly X+S*2 Y+SS
      pp_AddPoly X+S*2 Y
      pp_AddPoly X+S*2 Y
      pp_AddPoly X+S*3 Y
        IF X+X2<W THEN DO
            pp_AddPoly X+X2 Y
        END
        ELSE DO
            pp_AddPoly W Y
        END
    END

RETURN

LineV1: PROCEDURE
    X=ARG(1)
    Y=ARG(2)
    Y2=ARG(4)
    S=ARG(4)/3
    SS=ARG(3)/4
    n=ARG(5)
    H=ARG(6)
    IF n=0 THEN DO
        pp_AddPoly X Y+S
        pp_AddPoly X Y+S
        pp_AddPoly X+SS Y+S
        pp_AddPoly X+SS Y+S*2
        pp_AddPoly X Y+S*2
        pp_AddPoly X Y+S*2
        pp_AddPoly X Y+S*3
        IF Y+Y2<H THEN DO
            pp_AddPoly X Y+Y2
        END
        ELSE DO
            pp_AddPoly X H
        END
    END
    ELSE DO
        pp_AddPoly X Y+S
        pp_AddPoly X Y+S
        pp_AddPoly X-SS Y+S
        pp_AddPoly X-SS Y+S*2
        pp_AddPoly X Y+S*2
        pp_AddPoly X Y+S*2
        pp_AddPoly X Y+S*3
        IF Y+Y2<H THEN DO
            pp_AddPoly X Y+Y2
        END
        ELSE DO
            pp_AddPoly X H
        END
    END

RETURN


SavePrefs: PROCEDURE
    Prefname='PerfectPaint:Prefs/Rexx_Prefs/'||ARG(1)
    if EXISTS(Prefname) THEN DO
        ADDRESS COMMAND
        'delete >nil: '||Prefname
    END
    IF OPEN('pfile',PrefName,'W') THEN DO
    do i=2 to ARG()
        CALL WRITELN('pfile',ARG(i))
    end
    CALL CLOSE('pfile')
RETURN

MultiPoly: PROCEDURE
    DO i=1 to ARG(1)
        pp_AddPoly ARG(2) ARG(3)
    END
RETURN